home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tsptp.zip
/
GAMM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-04-09
|
5KB
|
180 lines
(******************************************************************************)
(* GAMM.PAS *)
(* *)
(* Gamm Benchmark. Based upon Pascal Validation Suite test 1.2-2. *)
(* Copyright A H J Sale and British Standards Institution, 1985. *)
(******************************************************************************)
PROGRAM GAMM(Output);
(******************************************************************************)
(* TIMING *)
(******************************************************************************)
(*$IFNDEF TopSpeed *)
(*%F TRUE *** Compile for Turbo Pascal ***)
USES TPBench;
(*%E*)
(*$ELSE *** Compile for TopSpeed Pascal ***)
IMPORT TSBench *;
(*$ENDIF *)
(******************************************************************************)
CONST
ITERATIONS = 10;
five = 5;
ten = 10;
thirty = 30;
VAR
i : 1..30;
acc, acc1,
divn, rn,
root,
x, y : BmReal;
a, b, c : ARRAY [1 .. thirty] OF BmReal;
PROCEDURE GammProc;
VAR i : 1..30;
BEGIN
(*** One pass of this procedure corresponds TO 300 Gamm units. ***)
(*** First addition/subtraction loop. ***)
FOR i := thirty DOWNTO 1 DO
c[i] := a[i] + b[i];
(*** First polynomial loop. ***)
y := 0.0;
FOR i := 1 TO ten DO
y := (y + c[i]) * x;
acc1 := y * divn;
(*** First maximum element loop. ***)
y := c[11];
FOR i := 12 TO 20 DO
IF c[i] > y THEN
y := c[i];
(*** First square root loop. ***)
root := 1.0;
FOR i := 1 TO 5 DO
root := 0.5 * (root + y/root);
acc1 := acc1 + root * divn;
(*** Second addition/subtraction loop. ***)
FOR i := 1 TO thirty DO
a[i] := c[i] - b[i];
(*** Second polynomial loop. ***)
y := 0.0;
FOR i := 1 TO ten DO
y := (y + a[i]) * x;
(*** Second square root loop. ***)
root := 1.0;
FOR i := 1 TO five DO
root := 0.5 * (root + y/root);
acc1 := acc1 + root * divn;
(*** First multiplication loop. ***)
FOR i := 1 TO thirty DO
c[i] := c[i] * b[i];
(*** Second maximum element loop. ***)
y := c[20];
FOR i := 21 TO thirty DO
IF c[i] > y THEN
y := c[i];
(*** Third square root loop. ***)
root := 1.0;
FOR i := 1 TO 5 DO
root := 0.5 * (root + y/root);
acc1 := acc1 + root * divn;
(*** Third polynomial loop. ***)
y := 0.0;
FOR i := 1 TO ten DO
y := (y + c[i]) * x;
acc1 := acc1 + y * divn;
(*** Third maximum element loop. ***)
y := c[1];
FOR i := 2 TO ten DO
IF c[i] > y THEN
y := c[i];
(*** Fourth square root loop. ***)
root := 1.0;
FOR i := 1 TO five DO
root := 0.5 * (root + y/root);
acc1 := acc1 + root * divn;
acc := acc + acc1
END;
BEGIN
WriteLn('Gamm Benchmark');
(******************************************************************************)
(* Compute the looping overhead. The Dummy procedure must have some side- *)
(* effect so that it is not optimised out of existence. *)
(******************************************************************************)
StartTimer; (* Start the clock. *)
REPEAT
Dummy;
UNTIL NullTimesUp;
(******************************************************************************)
(* Now run the benchmark. Note that the Dummy procedure is also called so *)
(* that we can eliminate its overhead from the looping overhead. *)
(******************************************************************************)
StartTimer; (* Start the clock. *)
REPEAT
rn := ITERATIONS;
divn := 1.0 / rn;
x := 0.1;
y := 1.0;
acc := 0.0;
FOR i := 1 TO 30 DO (* Initialise a and b. *)
BEGIN
a[i] := i;
b[i] := - y;
y := - y
END;
FOR i := 1 TO ITERATIONS DO
GammProc;
Dummy
UNTIL BenchTimesUp;
(******************************************************************************)
ReportTimes;
(*** Print the results. Should print n then: ***)
(*** 16.73343 22410 90064 71684 80142 13037 73134 63992 40462 96035 ***)
(*** 41872 24481 65285 24815 99961 62435 26126 76234 69822 97966 ***)
(*** and then 16.73 ... / ITERATIONS ***)
(*** Format should be adjusted to print to maximum precision. ***)
WriteLn;
WriteLn('Program acc = ', acc:31);
WriteLn('Theoretical acc = 1.67334322410900647168480E+1');
WriteLn('Program acc1 = ', acc1:31);
WriteLn('Theoretical acc1 = ', 16.7334322410900647168480/rn:31);
END.